home *** CD-ROM | disk | FTP | other *** search
/ Super CD / Super CD.iso / geomitri / acad10 / axrot.lsp < prev    next >
Lisp/Scheme  |  1988-08-04  |  2KB  |  73 lines
  1. ; *************************************************************************
  2. ;                              AXROT.LSP
  3. ;
  4. ; By Jan S. Yoder                                          May 11, 1988
  5. ;
  6. ; A routine to do 3 axis rotation of a selection set
  7. ;
  8. ; *************************************************************************
  9.  
  10. ; Internal error handler
  11.  
  12. (defun axerr (s)                      ; If an error (such as CTRL-C) occurs
  13.                                       ; while this command is active...
  14.    (if (/= s "Function cancelled")
  15.        (princ (strcat "\nError: " s))
  16.    )
  17.    (setq *error* olderr)              ; restore old *error* handler
  18.    (setvar "gridmode" ogm)            ; restore saved modes
  19.    (setvar "highlight" ohl)
  20.    (setvar "ucsfollow" oucsf)
  21.    (command "undo" "e")               ; complete undo group
  22.    (setvar "cmdecho" oce)
  23.    (princ)
  24. )
  25.  
  26. ; Main program
  27.  
  28. (defun c:axrot (/ olderr obpt ogm ohl oucsf ssel kwd dr bpt)
  29.    (setq olderr *error*
  30.        *error* axerr)
  31.    (setq oce   (getvar "cmdecho") 
  32.          ogm   (getvar "gridmode")
  33.          ohl   (getvar "highlight")
  34.          oucsf (getvar "ucsfollow"))
  35.  
  36.    (setvar "cmdecho" 0)
  37.    (command "undo" "group")
  38.    (setvar "gridmode" 0)
  39.    (setvar "ucsfollow" 0)
  40.  
  41.    (setq ssel (ssget))
  42.  
  43.    (setvar "highlight" 0)
  44.  
  45.    (initget 1 "X Y Z")
  46.    (setq kwd (getkword "\nAxis of rotation X/Y/Z: "))
  47.    (setq dr (getreal "\nDegrees of rotation <0>: "))
  48.    (if (null dr)
  49.       (setq dr 0)
  50.    )
  51.    (setq bpt (getpoint "\nBase point <0,0,0>: "))
  52.    (if (null bpt)
  53.       (setq bpt (list 0 0 0))
  54.    )
  55.    (setq bpt (trans bpt 1 0))
  56.    (cond 
  57.         ((= kwd "X") (command "ucs" "Y" "90"))
  58.         ((= kwd "Y") (command "ucs" "X" "-90"))
  59.         ((= kwd "Z") (command "ucs" "Z" "0"))
  60.    )
  61.    (setq bpt (trans bpt 0 1))
  62.    (command "rotate" ssel "" bpt dr)
  63.  
  64.    (command "ucs" "p")                ;restore previous ucs
  65.    (setvar "gridmode" ogm)            ;restore saved modes
  66.    (setvar "highlight" ohl)
  67.    (setvar "ucsfollow" oucsf)
  68.    (command "'redrawall")
  69.    (command "undo" "e")               ;complete undo group
  70.    (setvar "cmdecho" oce)
  71.    (princ)
  72. )
  73.